home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dskut / 2m21src.zip / 2M-INFO.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-31  |  37KB  |  835 lines
  1.  
  2. (*********************************************************************
  3. *                                                                    *
  4. *   2M-INFO 2.1  -  Pequeño programa de información sobre 2M.        *
  5. *                                                                    *
  6. *********************************************************************)
  7.  
  8. (*$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-*)
  9.  
  10. uses
  11.   Dos, Crt;
  12.  
  13. const
  14.   ID_ESPACIO     = 1886; (* límite en las gráficas *)
  15.   ID_VELOCIDAD   = 4850;
  16.  
  17.   CM_CIRIT       = 14;   (* colores para la pantalla inicial/final *)
  18.   CM_CIRIP       =  4;
  19.   CM_2M          = 10;
  20.   CM_2MS         = 10;
  21.   CM_VERT        = 13;
  22.   CM_VERF        =  6;
  23.   CM_VERS        =  5;
  24.   CM_INFO        =  9;
  25.   CM_PAUSA       = 11;
  26.   CC_RECUERDO    = 12;
  27.   CC_DIR         = 14;
  28.  
  29.   CE_BARRADOST   = 11;   (* colores para la grafica de capacidad *)
  30.   CE_BARRADOSP   =  1;
  31.   CE_BARRA2MT    = 14;
  32.   CE_BARRA2MP    =  4;
  33.   CE_INDICE      = 13;
  34.   CE_TITULOT     = 11;
  35.   CE_TITULOP     =  1;
  36.   CE_NOTA        = 14;
  37.   CE_BASECOL     = 15;
  38.   CE_LEYENDAS    = 10;
  39.  
  40.   CV_BARRADOST   =  3;   (* colores para la grafica de velocidad *)
  41.   CV_BARRADOSP   =  1;
  42.   CV_BARRA2MT    = 12;
  43.   CV_BARRA2MP    =  6;
  44.   CV_INDICE      = 13;
  45.   CV_TITULOT     = 11;
  46.   CV_TITULOP     =  5;
  47.   CV_NOTA        = 14;
  48.   CV_BASECOL     = 15;
  49.   CV_LEYENDAS    = 10;
  50.  
  51.   M_FONDO        =  1;   (* color del menú *)
  52.   M_SOMBRA       =  3;
  53.   M_TINTA        = 15;
  54.   M_IDIOMA       = 11;
  55.   M_TBARRA       =  0;
  56.   M_FBARRA       =  7;
  57.  
  58.   R_CABT         = 14;   (* color para el readme *)
  59.   R_CABP         =  5;
  60.   R_TINTA        = 11;
  61.   R_PAPEL        =  0;
  62.   R_DIR          = 14;
  63.   R_BRILLO       = 10;
  64.  
  65.   N_CABT         = 14;   (* color de las novedades *)
  66.   N_CABP         =  4;
  67.   N_TINTA        = 11;
  68.   N_PAPEL        =  1;
  69.  
  70.   O2_TINTA       = 14;   (* color de las información de OS/2 *)
  71.   O2_PAPEL       =  1;
  72.  
  73.   XT_TINTA       = 15;   (* color de la información de PC/XT *)
  74.   XT_PAPEL       =  1;   
  75.  
  76.   I_2M1          = 15;   (* color para la información de registro *)
  77.   I_2M2          = 13;
  78.   I_FONDO        =  0;
  79.   I_CIRI         = 14;
  80.   I_FLECHA       = 12;
  81.   I_STAR         = 15;
  82.   I_REG          = 11;
  83.   I_REGTT        = 11;
  84.   I_REGTP        =  1;
  85.   I_CON          = 10;
  86.   I_CONT         = 14;
  87.  
  88.  
  89. type
  90.   Vram=array [1..4096] of Byte;  (* tamaño de la memoria de vídeo *)
  91.   Matriz=array [0..3] of array [0..2] of Integer;
  92.  
  93. var
  94.   xPrev,yPrev,      (* coordenadas del cursor previas al programa *)
  95.   modo:Byte;        (* modo de pantalla previo a este programa *)
  96.   ScrColor:Vram absolute $b800:0;  (* dirección memoria pantalla color *)
  97.   ScrMono: Vram absolute $b000:0;  (*    "        "        " monocroma *)
  98.   pantalla:Vram;                   (* para preservar memoria de vídeo *)
  99.   opcion,                          (* Opción del menú en curso *)
  100.   ultopc: Integer;                 
  101.   idioma: Integer;                 (* 34 si castellano *)
  102.  
  103.  
  104. function ModoPantalla:Byte;
  105. var
  106.   r:Registers;
  107. begin
  108.   r.ah:=15; intr(16,r);  (* función BIOS para averiguar modo de pantalla *)
  109.   ModoPantalla:=r.al;
  110. end;
  111.  
  112.  
  113. procedure GuardarPantalla;
  114. begin
  115.   modo:=ModoPantalla; (* inicializar aquí esta variable global *)
  116.   if modo=7 then pantalla:=ScrMono else pantalla:=ScrColor;
  117.   xPrev:=whereX; yPrev:=whereY;
  118.   if (modo<>2) and (modo<>3) then TextMode(CO80);
  119. end;
  120.  
  121.  
  122. procedure ReponerPantalla;
  123. begin
  124.   textMode(modo);
  125.   window(1,1,80,25); gotoXY(xPrev,yPrev);
  126.   if (modo<=3) or (modo=7) then
  127.     if ModoPantalla=7 then ScrMono:=pantalla else ScrColor:=pantalla;
  128. end;
  129.  
  130.  
  131. procedure CursorOff;
  132. var
  133.   r:Registers;
  134. begin
  135.   r.dh:=100; r.dl:=0; r.bh:=0; (* coordenadas fuera de pantalla *)
  136.   r.ah:=2; intr(16,r)  (* servicio del BIOS para localizar el cursor *)
  137. end;
  138.  
  139.  
  140. function sp:Boolean;
  141. var
  142.   r:     Registers;
  143.   id:    Byte;
  144.   datos: array[1..128] of byte;
  145. begin
  146.   if idioma<2 then begin     (* 0-evaluar, 1-invertir, 2-sp, 3-eng *)
  147.         r.ah:=$30; MsDos(r);
  148.         if r.al>=3 then begin  (* DOS = 3.0 *)
  149.           r.ax:=$3800; r.ds:=SEG(datos); r.dx:=OFS(datos); msdos (r);
  150.           case r.bx of
  151.             54, 591, 57, 506, 56, 593, 503, 34, 63, 502,
  152.             504, 212, 52, 505, 507, 595, 51, 80, 508, 598,
  153.             58, 3, 0: id:=34;
  154.           end
  155.         end;
  156.         if idioma=0 then if id=34 then idioma:=2 else idioma:=3;
  157.         if idioma=1 then if id=34 then idioma:=3 else idioma:=2;
  158.       end;
  159.   sp:=idioma=2;
  160. end;
  161.  
  162.  
  163. procedure Pausa;
  164. var
  165.   t:Char;
  166. begin
  167.   CursorOff;
  168.   t:=readkey; if t=chr(0) then t:=readkey;
  169. end;
  170.  
  171.  
  172. procedure PantallaGalactica (logo: Boolean);
  173. var
  174.   x: Integer;
  175. procedure escribir (cad: String);
  176. var
  177.   i:Integer;
  178. begin
  179.   gotoxy (8, WhereY);
  180.   for i:=1 to length(cad) do
  181.     case cad[i] of
  182.       ' ':            write (' ');
  183.       '.', '·':       begin TextColor(random(6)+10); write (cad[i]); end;
  184.       '▒':            if i<35 then
  185.                           begin TextColor(CM_2M); write ('▒'); end
  186.                         else
  187.                           begin TextColor(CM_VERT); TextBackGround(CM_VERF);
  188.                                 write ('▒'); TextBackGround(0); end;
  189.       '█', '▄', '▀':  if i<35 then
  190.                           begin TextColor(CM_2MS); write (cad[i]); end
  191.                         else
  192.                           begin TextColor(CM_VERS); write (cad[i]); end;
  193.     end;
  194.   writeLn;
  195. end; (* escribir *)
  196. begin
  197.   TextBackGround(0); ClrScr;
  198.   RandSeed:=7;
  199.   for x:=1 to 79 do begin
  200.       gotoXY (x,random(25)); TextColor(random(6)+2);  write('.');
  201.       gotoXY (x,random(25)); TextColor(random(6)+2);  write('·');
  202.       gotoXY (x,random(25)); TextColor(random(6)+10); write('.');
  203.       gotoXY (x,random(25)); TextColor(random(6)+10); write('·');
  204.       gotoXY (x,random(25)); TextColor(random(6)+10); write('·');
  205.     end;
  206.   if logo=TRUE then begin
  207.     gotoxy (1,6);
  208.     escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▄  ▒▒▒▒▄      ▒▒▒▒▄');
  209.     escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█  ▒▒▒▒▒▄    ▒▒▒▒▒█');
  210.     escribir(' ▀▀▀▀▀▀▀▀▀▀▒▒▒▒█. ▒▒▒▒▒▒▄  ▒▒▒▒▒▒█');
  211.     escribir('    ·   .  ▒▒▒▒█  ▒▒▒▒▒▒▒▄▒▒▒▒▒▒▒█');
  212.     escribir(' ·     .   ▒▒▒▒█  ▒▒▒▒█▒▒▒▒▒█▒▒▒▒█');
  213.     escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ·▒▒▒▒█ ▒▒▒█▀▒▒▒▒█  .  ▒▒▒▒▒▒▒▒▒▒▄ .  ·   .▒▒▄');
  214.     escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█  ▒▒▒▒█  ▒█▀ ▒▒▒▒█      ▀▀▀▀▀▀▀▒▒█       ▒▒▒▒█');
  215.     escribir('▒▒▒▒█▀▀▀▀▀▀▀▀▀▀▀  ▒▒▒▒█ . ▀  ▒▒▒▒█    .   ·    ▒▒█  ·  ▒▒▄▀▒▒█');
  216.     escribir('▒▒▒▒█  ·  . ·     ▒▒▒▒█  · . ▒▒▒▒█     ▒▒▒▒▒▒▒▒▒▒█ .    ▀▀ ▒▒█');
  217.     escribir('▒▒▒▒█   .       · ▒▒▒▒█ ·    ▒▒▒▒█  ·  ▒▒█▀▀▀▀▀▀▀▀   .    .▒▒█');
  218.     escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▄  ▒▒▒▒█   .· ▒▒▒▒█     ▒▒█ ·  .  ·       · ▒▒█');
  219.     escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ .▒▒▒▒█  ·   ▒▒▒▒█   . ▒▒▒▒▒▒▒▒▒▒▄ ▒▒▄ ▒▒▒▒▒▒▒▒▒▒▄');
  220.     escribir(' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀   ▀▀▀▀ ·  .  ▀▀▀▀ ·    ▀▀▀▀▀▀▀▀▀▀  ▀▀  ▀▀▀▀▀▀▀▀▀▀');
  221.     CursorOff;
  222.   end;
  223. end;
  224.  
  225.  
  226. procedure Presentacion;
  227. begin
  228.   gotoxy(10,3); TextColor (CM_CIRIT); TextBackGround (CM_CIRIP);
  229.   write(' C I R I A C O    G A R C I A    D E    C E L I S    ');
  230.   if sp then write('presenta ') else write('presents ');
  231.   gotoxy(6-ord(sp),21); TextColor (CM_INFO); TextBackGround(0);
  232.   if sp then
  233.       write('El formateador de discos de mayor capacidad y velocidad ... en el mundo')
  234.     else
  235.       write('The highest capacity formatter of faster diskettes ... over the world');
  236.   gotoxy(34-ord(sp)*2,24); TextColor (CM_PAUSA);
  237.   if sp then
  238.       write('(Pulsa una tecla)')
  239.     else
  240.       write('(Press any key)');
  241.   CursorOff;
  242. end;
  243.  
  244.  
  245. procedure menu (var opcion: Integer);
  246. var
  247.   i:Integer;
  248.   t:Char;
  249. procedure PintaOp (opcion: Integer);
  250. begin
  251.   gotoXY (3,opcion+1);
  252.   case opcion of
  253.     1: if sp then
  254.            write(' 1.- COMPARATIVA DE CAPACIDAD DE LOS DISQUETES 2M ')
  255.          else
  256.            write(' 1.- STORAGE COMPARISON BETWEEN 2M AND DOS FORMAT ');
  257.     2: if sp then
  258.            write(' 2.- COMPARATIVA DE VELOCIDAD DE LOS DISQUETES 2M ')
  259.          else
  260.            write(' 2.- SPEED COMPARISON BETWEEN 2M AND DOS FORMAT ');
  261.     3: if sp then
  262.            write(' 3.- 2M ES MUY FACIL DE USAR ')
  263.